### CODE FOR:
###
### Partisan Influence on Policy Preferences 
### When Parties and Voters Disagree on Welfare Retrenchment
###
### PART 4: Preference gap examination (Figure 3 & Table A?)
###
### VERSION: 2023-JUN-14


rm(list=ls())
gc()



# WORKING DIRECTORY -------------------------------------------------------
setwd("C:/Users/miros/Desktop/Research/Finland - Partisan Cues in Citizens Attitudes")



# LIBRARIES ---------------------------------------------------------------
library(ggplot2)
library(RColorBrewer)
library(grid)
library(ggpubr)
library(dplyr)
library(ggtext)
library(tableHTML)
library(fixest)




# DATA IMPORT -------------------------------------------------------------
# NOTE: The data file loaded in the next step was prepared in a separate
#       scripts '01_PartyCues-data_prep.R'. If you haven't run the script, 
#       return to the depository and run that script first. Its output is 
#       'BIBU_long.Rda' loaded in the next step.
load("01-data/BIBU_long.Rda")
load("01-data/BIBU_panel.Rda")



# DATA ADJUSTMENTS --------------------------------------------------------
# NOTE: The following part reshapes the data into a suitable format for the
#       fixed effects model estimation.


# Creating two subsets of data (one for each policy reform)
BIBU.long.TUBE <- na.omit(BIBU.DiD[c("RETIREMENT_TUBE", "MEMBERID", "ROUND", "GovParty.Overall", "LeftRight")])
BIBU.long.SCHOOLING <- na.omit(BIBU.DiD[c("COMPULSORY_SCHOOLING", "MEMBERID", "ROUND", "GovParty.Overall", "LeftRight")])

# Identifying those 'MEMBERID' which are included twice in the data.
# NOTE: The goal is to subset only those individuals who participated in
#       both waves and we have two data points for each of them.
BIBU.long.TUBE.twice <- data.frame(table(BIBU.long.TUBE$MEMBERID))
BIBU.long.TUBE.twice$Include <- ifelse(BIBU.long.TUBE.twice$Freq == 2, 1, 0)

BIBU.long.SCHOOLING.twice <- data.frame(table(BIBU.long.SCHOOLING$MEMBERID))
BIBU.long.SCHOOLING.twice$Include <- ifelse(BIBU.long.SCHOOLING.twice$Freq == 2, 1, 0)

# Attaching the 'Include' variable (identifying respondents participating in both waves)
BIBU.long.TUBE <- merge(BIBU.long.TUBE, 
                        BIBU.long.TUBE.twice[c("Var1", "Include")], 
                        by.x = "MEMBERID", by.y = "Var1")
BIBU.long.SCHOOLING <- merge(BIBU.long.SCHOOLING, 
                             BIBU.long.SCHOOLING.twice[c("Var1", "Include")], 
                             by.x = "MEMBERID", by.y = "Var1")

# Subsetting only relevant observations (i.e., people participating in both waves)
BIBU.long.TUBE <- subset(BIBU.long.TUBE, Include == 1)
BIBU.long.SCHOOLING <- subset(BIBU.long.SCHOOLING, Include == 1)

# Removing irrelevant objects and variables
BIBU.long.TUBE$Include <- NULL
BIBU.long.SCHOOLING$Include <- NULL
rm(BIBU.long.TUBE.twice, BIBU.long.SCHOOLING.twice)

# NOTE: Now, 'BIBU.long.TUBE' and 'BIBU.long.SCHOOLING' include only 
#       respondents participating in both waves and hence the objects
#       are ready for fixed effects model estimation.





# ANALYSIS ----------------------------------------------------------------
# NOTE: The following part of the analysis examines the (overall) effect
#       of the party cues on voters' policy preferences. Estimated are
#       fixed effects models examining the revealed individual-level
#       shifts in policy preferences regarding the two reforms enacted by
#       the Finnish government. Visualized is gap emerging due to the
#       policy enactment. 




# _ TABLE 2: Models -------------------------------------------------------

# Adjusting the factor levels (so the relevant coefficients relate to the
# government voters - i.e., the main group of interest)
BIBU.long.TUBE$GovParty.Overall <- factor(BIBU.long.TUBE$GovParty.Overall,
                                          levels = c("Opposition voters", 
                                                     "Government voters"))

BIBU.long.SCHOOLING$GovParty.Overall <- factor(BIBU.long.SCHOOLING$GovParty.Overall,
                                               levels = c("Opposition voters", 
                                                          "Government voters"))


# __ Model estimation -----------------------------------------------------

# Model 1: Abolishment of the 'Retirement Tube'
fd.model.1 <- feols(RETIREMENT_TUBE ~ ROUND*GovParty.Overall | MEMBERID, 
                    data = BIBU.long.TUBE, 
                    cluster = "MEMBERID")

# Model 1-LR: Abolishment of the 'Retirement Tube'
fd.model.1.LR <- feols(RETIREMENT_TUBE ~ ROUND*GovParty.Overall + LeftRight | MEMBERID, 
                       data = BIBU.long.TUBE, 
                       cluster = "MEMBERID")

# Model 2: Increase of the upper age limit for compulsory schooling
fd.model.2 <- feols(COMPULSORY_SCHOOLING ~ ROUND*GovParty.Overall | MEMBERID,  
                    data = BIBU.long.SCHOOLING, 
                    cluster = "MEMBERID")

# Model 2-LR: Increase of the upper age limit for compulsory schooling
fd.model.2.LR <- feols(COMPULSORY_SCHOOLING ~ ROUND*GovParty.Overall + LeftRight | MEMBERID,  
                    data = BIBU.long.SCHOOLING, 
                    cluster = "MEMBERID")

# Model(s) summary
etable(fd.model.1, fd.model.1.LR, fd.model.2, fd.model.2.LR)



# Exporting the table
write_tableHTML(
  tableHTML(
    etable(fd.model.1, fd.model.2, tex = FALSE)), 
  file = "02-figures and models/Tab A1 - government vs opposition overall change.html")




# _ FIGURE 3 --------------------------------------------------------------

# __ Extracting the marginal effects --------------------------------------
margins <-
  data.frame(
    rbind(
      c("Abolishment of\nthe 'Retirement Tube'",      "Before\nthe reform", "Government\nvoters", 0, NA, NA),
      c("Abolishment of\nthe 'Retirement Tube'",      "After\nthe reform","Government\nvoters", broom::tidy(fd.model.1, conf.int = .95)[2 , c("estimate", "conf.low", "conf.high")]),
      c("Extension of\nthe compulsory schooling age", "Before\nthe reform", "Government\nvoters", 0, NA, NA),
      c("Extension of\nthe compulsory schooling age", "After\nthe reform","Government\nvoters", broom::tidy(fd.model.2, conf.int = .95)[2 , c("estimate", "conf.low", "conf.high")])
    ))

# Changing column names
names(margins) <- c("reform", "time", "group", "estimate", "conf.low", "conf.high")

# Unlisting the rows
margins$reform <- factor(unlist(margins$reform), levels = c("Abolishment of\nthe 'Retirement Tube'", "Extension of\nthe compulsory schooling age"))
margins$time <- factor(unlist(margins$time), levels = c("Before\nthe reform", "After\nthe reform"))
margins$estimate <- as.numeric(unlist(margins$estimate))
margins$conf.low <- as.numeric(unlist(margins$conf.low))
margins$conf.high <- as.numeric(unlist(margins$conf.high))




# __ Figure ---------------------------------------------------------------

ggarrange(
  
  # Abolishment of the retirement tube
  ggplot(subset(margins, reform == "Abolishment of\nthe 'Retirement Tube'"), 
         aes(x = time, y = estimate, group = reform)) +
    geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
    geom_point() +
    geom_line() +
    annotate("richtext", x = 2.0, y = 0.2805371, hjust = 0, vjust = 0.5, 
             label = "<b>Government</b><br>voters", 
             size = 7/.pt, lineheight = 0.8, fill = NA, label.color = NA) +
    annotate("richtext", x = 2.5, y = -0.0625/2, hjust = 1, vjust = 0.5, 
             label = "Reference: <b>Opposition</b> voters", 
             size = 7/.pt, colour = "grey60", lineheight = 0.8, fill = NA, label.color = NA) +
    geom_errorbar(aes(ymin = conf.low, ymax = conf.high, width = 0.2)) +
    scale_y_continuous(breaks = seq(-0.5, 0.5, 0.125), labels = c("-0.50", "", "-0.25", "", "0.00", "", "0.25", "", "0.50")) +
    geom_rect(ymin = 0.5, ymax = 0.7, xmin = 0.5, xmax = 2.5, colour = "black", fill = "grey90") +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust = -0.10, label = "Welfare retrenchment", fontface = 2, size = 11/.pt) +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust =  1.70, label = "Abolition of the \"retirement tube\"", size = 8/.pt) +
    coord_cartesian(xlim = c(0.5, 2.5), ylim = c(-0.5, 0.7), expand = FALSE, clip = "off") +
    labs(y = expression(paste(symbol('\254'), " Lower support ",~-~bold(Estimate)~-~" Higher support ", symbol('\256'), "                ")), x = NULL, title = NULL) +
    theme(axis.title.y = element_text(size = 8),
          axis.text = element_text(size = 8),
          panel.grid.major.x = element_blank(), 
          panel.grid.major.y = element_line(colour = "gray90"), 
          panel.grid.minor.y = element_line(colour = "gray90"),
          panel.background = element_rect(fill = "transparent", colour = "black"),
          plot.background = element_rect(fill = "transparent", colour = "transparent"),
          panel.border = element_rect(fill = "transparent", colour = "black"),
          axis.ticks.y = element_blank(),
          plot.margin = unit(c(0.05, 0.05, 0.05, 0.05),"cm")),
  
  
  # Compulsory schooling extension
  ggplot(subset(margins, reform == "Extension of\nthe compulsory schooling age"), 
         aes(x = time, y = estimate, group = reform)) +
    geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
    geom_point() +
    geom_line() +
    annotate("richtext", x = 2.0, y = 0.2586121, hjust = 0, vjust = 0.5, 
             label = "<b>Government</b><br>voters", 
             size = 7/.pt, lineheight = 0.8, fill = NA, label.color = NA) +
    annotate("richtext", x = 2.5, y = -0.0625/2, hjust = 1, vjust = 0.5, 
             label = "Reference: <b>Opposition</b> voters", 
             size = 7/.pt, colour = "grey60", lineheight = 0.8, fill = NA, label.color = NA) +
    geom_errorbar(aes(ymin = conf.low, ymax = conf.high, width = 0.2)) +
    scale_y_continuous(breaks = seq(-0.5, 0.5, 0.125), labels = c("-0.50", "", "-0.25", "", "0.00", "", "0.25", "", "0.50")) +
    geom_rect(ymin = 0.5, ymax = 0.7, xmin = 0.5, xmax = 2.5, colour = "black", fill = "grey90") +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust = -0.10, label = "Welfare expansion", fontface = 2, size = 11/.pt) +
    annotate("text", x = 1.5, y = 0.6, hjust = 0.5, vjust =  1.70, label = "Extension of the compulsory school age", size = 8/.pt) +
    coord_cartesian(xlim = c(0.5, 2.5), ylim = c(-0.5, 0.7), expand = FALSE, clip = "off") +
    labs(y = NULL, x = NULL, title = NULL) +
    theme(axis.title.y = element_text(size = 9),
          axis.text.y = element_blank(),
          axis.text = element_text(size = 8),
          panel.grid.major.x = element_blank(), 
          panel.grid.major.y = element_line(colour = "gray90"), 
          panel.grid.minor.y = element_line(colour = "gray90"),
          panel.background = element_rect(fill = "transparent", colour = "black"),
          plot.background = element_rect(fill = "transparent", colour = "transparent"),
          panel.border = element_rect(fill = "transparent", colour = "black"),
          axis.ticks.y = element_blank(),
          plot.margin = unit(c(0.05, 0.05, 0.05, 0.05),"cm")),
  
  
  # Specs
  nrow = 1, widths = c(10, 8.75)) + 
  theme(panel.background = element_rect(fill = "white", color = "transparent"))



# Saving the output
ggsave(filename = "02-figures and models/Fig 3 - government vs opposition - preference gap.png", width = 14.5, height = 10, units = "cm", dpi = 600)



# Cleanup
rm(BIBU.long.TUBE, BIBU.long.SCHOOLING, fd.model.1, fd.model.2, margins)
rm(BIBU.DiD, BIBU.panel)


